home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / qbprog.EXE / HSCBAS.BAS < prev    next >
Encoding:
BASIC Source File  |  1980-01-10  |  1.3 KB  |  54 lines
  1. DECLARE SUB Dinle (BYVAL Segm%, BYVAL Ofset%, BYVAL Bel%)
  2. DECLARE SUB Kapa ()
  3. DECLARE SUB YavasKapa ()
  4. DECLARE SUB Bellek (A%)
  5. DECLARE SUB Bekle ()
  6. TYPE Dosyalar
  7.       Ax    AS INTEGER
  8.       Bx    AS INTEGER
  9.       Cx    AS INTEGER
  10.       Dx    AS INTEGER
  11.       bp    AS INTEGER
  12.       si    AS INTEGER
  13.       di    AS INTEGER
  14.       Flags AS INTEGER
  15.       Ds    AS INTEGER
  16.       Es    AS INTEGER
  17.       HscDt AS STRING * 15000
  18. END TYPE
  19. DECLARE SUB Interruptx (Kesme AS INTEGER, Git AS Dosyalar, Gel AS Dosyalar)
  20. DIM SHARED Yap AS Dosyalar
  21. DIM SHARED BellekC%
  22.  
  23.     CLS
  24.     A$ = "odam.hsc"
  25.     CLOSE #1: OPEN A$ FOR BINARY AS #1
  26.     IF LOF(1) = 0 THEN CLOSE #1: KILL A$: PRINT A$; " bulunamadì..": END
  27.  
  28.     CALL Bellek(11913): BellekC% = Yap.Ax
  29.     Yap.HscDt = SPACE$(LOF(1))
  30.     GET #1, , Yap.HscDt
  31.     Dinle VARSEG(Yap.HscDt), VARPTR(Yap.HscDt), BellekC%
  32.  
  33.     PRINT A$; " dinleniyor, Esc)Bitir"
  34.     DO: LOOP UNTIL INP(&H60) = 1
  35.     YavasKapa
  36.     FOR I = 1 TO 5: Bekle: NEXT
  37.     Kapa
  38.     CLS : END
  39.  
  40. SUB Bekle
  41.      DEF SEG = 0
  42.      FOR I = 1 TO 15
  43.       A = PEEK(1132): DO: LOOP UNTIL PEEK(1132) <> A
  44.      NEXT
  45. END SUB
  46.  
  47. SUB Bellek (A%)
  48.     Bos& = SETMEM(-1 * (A% + 17))
  49.     Yap.Ax = &H4800: Yap.Bx = A% \ 16 + 1
  50.     CALL Interruptx(&H21, Yap, Yap)
  51.     IF (Yap.Flags AND 1) THEN PRINT "Hata": END
  52. END SUB
  53.  
  54.